home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dbcexe / primary.bas < prev    next >
BASIC Source File  |  1999-03-30  |  3KB  |  75 lines
  1. Attribute VB_Name = "Primary"
  2. Option Explicit
  3.     Public MyWorkspace As Workspace
  4.     Public sTestPath As String
  5.     Public dbTest As Database
  6.     Public sDataPath As String
  7.     Public bFound As Boolean
  8.     Public bFirst As Boolean
  9.     Public oError As New ErrorHandler
  10. '---------------------------------------------------------------------'
  11. Sub Main()
  12.     bFirst = True
  13.     sDataPath = CurDir & "\"
  14.     sTestPath = sDataPath & "Test.mdb"
  15.     Call OpenDatabases
  16.     frmNames.Show
  17. End Sub
  18. '---------------------------------------------------------------------'
  19. Public Sub OpenDatabases()
  20.     Dim iCount As Integer
  21.     Set MyWorkspace = DBEngine.Workspaces(0)
  22.     For iCount = 0 To 20
  23.         Set dbTest = MyWorkspace.OpenDatabase(sTestPath, _
  24.                             False, False, ";PWD=")
  25.         Select Case Err.Number
  26.         Case 0: Exit For
  27.         Case 3050:
  28.             If iCount = 20 Then
  29.                 MsgBox "The Test database is locked by another user.  If you cannot get into the program after a few tries, then check to see if another user is editing the Access database or if a user is locked in this program.", vbCritical + vbOKOnly, "Database is locked"
  30.                 CloseAll
  31.                 EndApp
  32.                 Exit Sub
  33.             End If
  34.         End Select
  35.     Next
  36. End Sub
  37. '---------------------------------------------------------------------'
  38. Public Sub DBCompact()
  39.     '-- Unload anything that accesses the database(s)
  40.     Unload frmNames
  41.     
  42.     '--
  43.     Call CloseAll
  44.     On Error GoTo AAARRRGGGHHH
  45.     '-- Delete old backup files
  46.     If Not Dir(sDataPath & "OldTest.mdb") = vbNullString Then Call Kill(sDataPath & "OldTest.mdb")
  47.     '-- Rename current files to backup file names (keeps other users from accessing through pgm)
  48.     Name sDataPath & "Test.mdb" As sDataPath & "OldTest.mdb"
  49.     '-- Repair the backup files
  50.     Call DBEngine.RepairDatabase(sDataPath & "OldTest.mdb")
  51.     '-- Compact the backup files back into the datafiles
  52.     Call DBEngine.CompactDatabase(sDataPath & "OldTest.mdb", sDataPath & "Test.mdb")
  53.     GoTo SkipAAARRRGGGHHH
  54. AAARRRGGGHHH:
  55.     If Not oError(Err.Number, "Error compacting databases") Then Resume
  56. SkipAAARRRGGGHHH:
  57.     On Error GoTo 0
  58.     bFirst = True
  59.     Call OpenDatabases
  60.     '-- Show the forms again
  61.     frmNames.Show
  62. End Sub
  63. '---------------------------------------------------------------------'
  64. Public Sub CloseAll()
  65.     dbTest.Close
  66.     MyWorkspace.Close
  67.     Set MyWorkspace = Nothing
  68.     Set dbTest = Nothing
  69. End Sub
  70. '---------------------------------------------------------------------'
  71. Public Sub EndApp()
  72.     End
  73. End Sub
  74.  
  75.